'##################################################
'###  Top Level (Get root Path from system env)
'##################################################
function GetEnv(envVarName)
	On Error Resume Next
	' 创建Shell对象并获取值
	Set WshShell = CreateObject("WScript.Shell")
	envValue = WshShell.Environment("PROCESS")(envVarName) ' 优先查找进程级变量

	' 如果未找到则尝试系统级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("SYSTEM")(envVarName)
	End If

	' 如果仍未找到则尝试用户级变量
	If Err.Number <> 0 Or envValue = "" Then
		Err.Clear
		envValue = WshShell.Environment("USER")(envVarName)
	End If

	' 检查结果并输出
	If Err.Number = 0 And envValue <> "" Then
		GetEnv=envValue
	Else
		GetEnv=""
	End If
end function

'##################################################
'##################################################
'##################################################
sub IncludeVbs(filepath)
	Dim fso, file, content
	Set fso = CreateObject("Scripting.FileSystemObject")
	' 读取functions.vbs的内容
	Set file = fso.OpenTextFile(filepath, 1) ' 1表示只读
	content = file.ReadAll
	file.Close
	' 将functions.vbs的内容载入全局作用域
	ExecuteGlobal content
end sub

'##################################################
'##################################################
'##################################################
dim root,tmpfile
Dim doc
Set doc = application.ActiveDocument
dim userLayerName:userLayerName="temp"
main
set doc = nothing
sub main()	
	'// REUSE
	envVarName ="EXP_SHORTCUTS_ROOT"
	root = GetEnv(envVarName)'"C:\MentorGraphics\2005EXP\SDD_HOME\pvtk\env\"
	if root ="" then 
		msgbox "please set env value (EXP_SHORTCUTS_ROOT = ?)"
		exit sub
	end if
	
	call IncludeVbs(root & "\skill_lib.vbs")
	
	If ValidateServer(doc) = 0 Then
	    msgbox "Server validation failed."
	    exit sub
	End If	
	
	'// TODO
	dim mode
	mode = application.gui.ActiveMode 
	select case mode
		case 0 'place
			copy_place
		case 1 'route
			copy_route
	end select
	msgbox "done"
end sub

'############################################
'############################################
'############################################
sub copy_place()
	dim Num
	dim cmp,cmps,cmpsall
	dim NrefList:NrefList=""
	set cmpsall = doc.components(0)
	for each cmp in cmpsall
		if left(cmp.name,2) = "N_" then
			NrefList = NrefList & right(cmp.name,len(cmp.name)-2) & " "
		end if 
	next
	NrefList = Trim(NrefList)
	dim s,ls,i
	s = split(NrefList," ")
	ls = ubound(s)-lbound(s)+1
	dim imark:imark=0
	set cmps = doc.components(1)
	dim cellname
	if cmps.count = 0 then 
		Num=GetRandomMath(1,9999)
		for i=0 to ls-1
			if Num = s(i) then 
				imark=1
			end if
		next
		do while imark=1			
			imark =0
			Num=GetRandomMath(1,9999)
			for i=0 to ls-1
				if Num = s(i) then
					imark=1
				end if
			next
			msgbox imark
		loop
		cmp_new_ref ="N_" & Num
		cellname = inputbox("input cellname=?" ,cellname,"SDCW2012-2")
		'unsupport at this version
		'Call doc.PutComponent(cellname, true, doc.activeview.MousePositionX , doc.activeview.MousePositionY, 0.0,cmp_new_ref, , 1, False, epcbAnchorNone, epcbUnitCurrent, epcbAngleUnitDegrees)		
	else
		dim cmpObj
		dim cmp_new_ref
		'msgbox doc.activeview.MousePositionX 
		doc.TransactionStart(0)	
		for each cmp in cmps
			Num=GetRandomMath(1,9999)
			for i=0 to ls-1
				if Num = s(i) then 
					imark=1
				end if
			next
			do while imark=1			
				imark =0
				Num=GetRandomMath(1,9999)
				for i=0 to ls-1
					if Num = s(i) then
						imark=1
					end if
				next
				msgbox imark
			loop
			'msgbox Num
			cmp_new_ref ="N_" & Num
			'msgbox cmp_new_ref
			Call doc.PutComponent(cmp.cell.name, false, doc.activeview.MousePositionX , doc.activeview.MousePositionY, cmp.Orientation,cmp_new_ref, , 1, False, epcbAnchorNone, epcbUnitCurrent, epcbAngleUnitDegrees)		
		next	
		doc.TransactionEnd (1) 		
	end if
		
end sub

sub copy_route()
	Dim usrLyrObj
	doc.currentunit=2 'th		
	
	Set usrLyrObj = doc.FindUserLayer(userLayerName)
	If usrLyrObj Is Nothing Then
		Set usrLyrObj = doc.SetupParameter.PutUserLayer(userLayerName)
	Else
		doc.UserLayerGfxs(, userLayerName).Delete
	End If
	
	call CheckUserlyr(userLayerName)
	dim fabGfxObj
	dim numPoints,pntsArr
	'// copy trace
	dim pcbtraces,pcbtrace
	dim pcbtracewidth
	set pcbtraces = doc.traces(1)
	for each pcbtrace in pcbtraces
		pcbtracewidth = pcbTrace.Geometry.LineWidth
		pntsArr = pcbTrace.Geometry.pointsarray
		numPoints = UBound(pntsArr, 2) + 1
		call doc.PutUserLayerGfx(usrLyrObj,pcbtracewidth,numPoints,pntsArr,False,Nothing,epcbUnitCurrent)
	next
	
	'// copy pstack
	dim pads_pstack,pad_pstack
	dim pinpads,pinpad
	dim pinpo,pinpos
	dim pntArr
	
	dim cx,cy,cr
	dim pstacks,pstack,selpskt
	Set pstacks = doc.PadstackObjects(1 or 2,1) '1:pin | 2:via
	for each pstack in pstacks
		selpskt = pstack.CurrentPadstack 
		select case pstack.Type
			case 2 'via
				cx = pstack.positionX
				cy = pstack.positionY
				cr = (pstack.Extrema.MaxX - pstack.Extrema.MinX)*0.5	
				pntArr = application.Utility.CreateCircleXYR(cx,cy,cr)
			case 1 'pin
				set pinpads = pstack.pads
				for each pinpad in pinpads
					set pinpos = pinpad.Geometries
					for each pinpo in pinpos
						pntArr = pinpo.PointsArray
						exit for
					next
					exit for
				next
		end select	
		numPoints = UBound(pntArr, 2) + 1		
		set fabGfxObj = doc.PutUserLayerGfx(usrLyrObj,1.0,numPoints,pntArr,true,Nothing,epcbUnitCurrent)
	next

end sub

'############################################
'############################################
'############################################

Function GetRandomMath(m,n)
	Randomize
	GetRandomMath = Int(((n-m+1) * Rnd) + m)
End Function

sub CheckUserlyr(ulyr)	
	' TOP level		
	Dim displCtrlObj
	Set displCtrlObj = doc.ActiveView.DisplayControl
	Dim dispCtrlGlobalObj
	Set dispCtrlGlobalObj = displCtrlObj.Global
	dispCtrlGlobalObj.UserLayerDisplayLevel(ulyr) = epcbDisplayLevelTop
	dispCtrlGlobalObj.RaiseUserLayerDisplayLevel(ulyr)
	displCtrlObj.UserLayer(ulyr)=True
	'red color
	dim NColorObject
	set NColorObject = application.utility.NewColorPattern 
	With NColorObject
			.red = 255
			.green =0
			.blue =0
			.index =0
			.outline=false
			.Transparent=false
	end With
	set doc.activeView.DisplayControl.Global.UserLayerColor(ulyr)=NColorObject
end sub
